home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Source Code / Libraries / SAT 2.3.8 / Demos / HeartQuest demo ƒ / main.p < prev    next >
Text File  |  1996-05-23  |  13KB  |  400 lines
  1. {================================================}
  2. {=============== HeartQuest main unit ================}
  3. {================================================}
  4.  
  5. { Example file for Ingemars Sprite Animation Toolkit. }
  6. { © Ingemar Ragnemalm 1992 }
  7. { See doc files for legal terms for using this code. }
  8.  
  9. { HeartQuest is a very simple game demonstrating how to use the Sprite Animation}
  10. { Toolkit. I originally wrote the game as my present to my wife Eva for Valentine's}
  11. { day 1992. You can still tell that this file once started as the Skel example in the}
  12. { TransSkel package by Paul DuBois and Owen Hartnett. }
  13.  
  14. { This "main" file is rather small, and holds very little game specific code.}
  15. { Its main concern is to initialize the various parts of the game, and to hold the}
  16. { file and edit menu handlers. }
  17.  
  18. program HeartQuest;
  19.  
  20.     uses
  21. {$IFC UNDEFINED THINK_PASCAL}
  22.         Types, Quickdraw, Events, Windows, Resources, Fonts, {}
  23.         Menus, Memory, QuickDrawText, Errors, OSUtils, EPPC,
  24. {$ENDC}
  25.         TransSkel, SAT, GameGlobals, GameWindow, {sound,}
  26.         SoundConst, scores, CenterStuff, Preferences, AppleEvents, ClutFade;
  27.  
  28. {Variables for the main program}
  29.     var
  30.         keys: KeyMap;
  31.         zoomFlag: Boolean;
  32.         ignore: longint;                        {For UnloadScrap error}
  33.         gAppleEventsInitialized: Boolean;    {For initializing Apple Events when necessary}
  34.  
  35. { -------------------------------------------------------------------- }
  36. {                        Menu handling procedures                        }
  37. { -------------------------------------------------------------------- }
  38.  
  39. {    Handle selection of "About…" item from Apple menu}
  40.  
  41.     procedure DoAbout;
  42.         var
  43.             ignore: integer;
  44.     begin
  45.         ignore := DoAlert(43, aboutAlrt, nil);
  46.     end;
  47.  
  48. {    Process selection from File menu.}
  49.  
  50. {    HelpEnemies    Shows a help box. }
  51. {    Quit    Request a halt by calling SkelHalt().  This makes SkelMain}
  52. {            return.}
  53.  
  54.     procedure DoFileMenu (item: integer);
  55.         var
  56.             ignore: integer;
  57.     begin
  58.         case item of
  59.             helpenemies: 
  60.                 ignore := DoAlert(43, helpenemiesAlrt, nil);
  61.             quit: 
  62.                 begin
  63.                     if pauseFlag then
  64.                         DoGameOver;
  65.                     SkelWhoa;
  66.                 end;
  67.             otherwise
  68.                 ;
  69.         end;
  70.     end;
  71.  
  72.     procedure DoEditMenu;
  73.     begin
  74.     end;
  75.  
  76. {    Initialize menus.  Tell TransSkel to process the Apple menu}
  77. {    automatically, and associate the proper procedures with the}
  78. {    File and Edit menus.}
  79.  
  80.     procedure SetUpMenus;
  81.     begin
  82.         SkelApple(MyGetIndString(aboutStrID), @DoAbout); {string 1: About HeartQuest…}
  83.         fileMenu := GetMenu(fileMenuRes);
  84.         editMenu := GetMenu(editMenuRes);
  85.         GameMenu := GetMenu(GameMenuRes);
  86.         highMenu := GetMenu(highMenuRes);
  87.         dummy := SkelMenu(fileMenu, @DoFileMenu, nil, false);
  88.         dummy := SkelMenu(editMenu, @DoEditMenu, nil, false);
  89.         dummy := SkelMenu(GameMenu, @DoGameMenu, nil, false);
  90.         dummy := SkelMenu(highMenu, @DoHighMenu, nil, true);
  91.     end;
  92.  
  93. { Initialize settings resources. These are saved in the game file itself. This is elegant,}
  94. { but a bit "server-hostile". An alternative is to create a preference file in the system}
  95. { folder. The routine determining where preferences should be saved, in Preferences.p,}
  96. { has a parameter that can be set to always save in a preference file, if you prefer that.}
  97.  
  98.     procedure InitSettings;
  99.     begin
  100.         UseResFile(gPrefFile); {set the resfile to the pref file, if any. If none, gPrefFile will be the app itself!}
  101.         features := featHnd(GetResource('Feat', 0));        { Load the settings }
  102.         if features = nil then                                { Settings doesn't exist; create new }
  103.             begin
  104.                 features := featHnd(NewHandle(Sizeof(featRec)));
  105.                 CheckNoMem(Ptr(features));
  106.                 features^^.sound := true;
  107.                 features^^.allowBG := false;
  108.                 features^^.player := MyGetIndString(anonymousStrID); {str 2: Anonymous}
  109.                 features^^.macho := false;
  110.                 AddResource(handle(features), 'Feat', 0, 'Settings');
  111.             end
  112.         else                                                    {Did exist - check the size!}
  113.             if GetHandleSize(Handle(features)) < sizeof(featHnd) then
  114.                 SetHandleSize(Handle(features), sizeof(featHnd));
  115.         UseResFile(gAppFile);
  116.  
  117. { Fix all checkmarks in the menus }
  118.         if features^^.sound then
  119.             begin
  120.                 features^^.sound := false;
  121.                 DoGameMenu(sound);
  122.             end
  123.         else
  124.             begin
  125.                 features^^.sound := true;
  126.                 DoGameMenu(sound);
  127.             end;
  128.         if features^^.macho then
  129.             begin
  130.                 features^^.macho := false;
  131.                 DoGameMenu(macho);
  132.             end
  133.         else
  134.             begin
  135.                 features^^.macho := true;
  136.                 DoGameMenu(macho);
  137.             end;
  138.         if features^^.PlotFast then
  139.             begin
  140.                 features^^.PlotFast := false;
  141.                 DoGameMenu(FastAnimation);
  142.             end
  143.         else
  144.             begin
  145.                 features^^.PlotFast := true;
  146.                 DoGameMenu(FastAnimation);
  147.             end;
  148.         if features^^.allowBG then
  149.             begin
  150.                 features^^.allowBG := false;
  151.                 DoGameMenu(allowBG);
  152.             end
  153.         else
  154.             begin
  155.                 features^^.allowBG := true;
  156.                 DoGameMenu(allowBG);
  157.             end;
  158.     end;
  159.  
  160.  
  161. { ******* MultiFinder and Apple events: ******* }
  162.  
  163. {MultiFinder events - suspend and reume - have been handled by HeartQuest since very early versions,}
  164. {since I want it to hide its window when switched out.}
  165. {AppleEvents are added, mostly because I wanted to learn about it. I learned one thing: Apple Events are}
  166. {tedious. I tried simplifying AppleEvent support by installing my handlers first after getting an Apple}
  167. {Event (getting rid of all checking for its existence - if it sends events to me, it exists) - but the interface}
  168. {files needed are horrible. To speed up compilation, I made a stripped down interface file, HQAE.p.}
  169. {All I really got by supporting Apple Events is that I can quit after getting the 'quit' Apple event.}
  170.  
  171. {Handle the required Apple events:}
  172. {DoOpenApp,DoOpenDoc,DoPrintDoc,DoQuitApp}
  173. {MyGotRequiredParams: From MSG demo my Mark Pilgrim, tells whether we have handled all we have to or not.}
  174.     function MyGotRequiredParams (theAppleEvent: AppleEvent): OSErr;
  175.         var
  176.             returnedType: DescType;
  177.             actualSize: Size;
  178.     begin
  179.         if AEGetAttributePtr(theAppleEvent, keyMissedKeywordAttr, typeWildCard, returnedType, nil, 0, actualSize) = errAEDescNotFound then
  180.             MyGotRequiredParams := noErr
  181.         else
  182.             MyGotRequiredParams := errAEParamMissed;
  183.     end;
  184.     function DoOpenApp (theAppleEvent, reply: AppleEvent; refCon: Longint): OSErr;
  185.     begin
  186. {What am I supposed to do here?}
  187.         DoOpenApp := MyGotRequiredParams(theAppleEvent);
  188.     end;
  189.     function DoOpenDoc (theAppleEvent, reply: AppleEvent; refCon: Longint): OSErr;
  190.     begin
  191.         DoOpenDoc := errAEEventNotHandled; {We don't open any documents!}
  192.     end;
  193.     function DoPrintDoc (theAppleEvent, reply: AppleEvent; refCon: Longint): OSErr;
  194.     begin
  195.         DoPrintDoc := errAEEventNotHandled; {We don't print any documents!}
  196.     end;
  197.     function DoQuitApp (theAppleEvent, reply: AppleEvent; refCon: Longint): OSErr;
  198.     begin
  199.         SkelWhoa;            {If I'm told to quit, I'll quit.}
  200.         DoQuitApp := MyGotRequiredParams(theAppleEvent);
  201.     end;
  202.  
  203. {Init Apple events}
  204. {Perhaps I'm cheating, but I don't call this until I get the first Apple event.}
  205. {IMHO, that's the simplest way to support them without a lot of boring Gestalt checks.}
  206.     procedure AppleEventInit;
  207.         var
  208.             error: OSerr;
  209.     begin
  210.         if gAppleEventsInitialized then
  211.             exit(AppleEventInit);
  212.         gAppleEventsInitialized := true;
  213.         error := AEInstallEventHandler(kCoreEventClass, kAEOpenApplication, @DoOpenApp, 0, false);
  214.         error := AEInstallEventHandler(kCoreEventClass, kAEOpenDocuments, @DoOpenDoc, 0, false);
  215.         error := AEInstallEventHandler(kCoreEventClass, kAEPrintDocuments, @DoPrintDoc, 0, false);
  216.         error := AEInstallEventHandler(kCoreEventClass, kAEQuitApplication, @DoQuitApp, 0, false);
  217. {I ignore errors.}
  218.     end;
  219.  
  220.  
  221. {Event processing that TransSkel nowadays HAS support for:}
  222. {MultiFinder events: Hide gameWindow on suspend, so the user can get access to disk icons etc.}
  223. {Apple Events: Handle the required Apple events.}
  224.  
  225.     procedure DoSuspendResume (b: Boolean);
  226.     begin
  227.         if b then
  228. {Resume event: show game window and set the sleep time to something fairly low}
  229.             begin
  230.                 ShowWindow(gSAT.wind.port);
  231.                 SelectWindow(gSAT.wind.port);
  232.                 SkelSetSleep(5);
  233.             end
  234.         else
  235. {Suspend event: Hide the game window and set the sleep time to something high}
  236. {(Not that the sleep time matters when "can background" is false, but I put it in for demonstrating it.)}
  237.             begin
  238.                 HideWindow(gSAT.wind.port);
  239.                 SkelSetSleep(60);
  240.             end;
  241.     end;
  242.  
  243.     function DoEvt (e: eventRecord): boolean;
  244.     begin
  245. {In older versions, we handled Apple events and suspend/resume events here. Since then,}
  246. {I have added support for them in TransSkel.p, so now this is only used for installing our}
  247. {Apple Event handlers upon acceptance of the first Apple Event.}
  248.  
  249. {Old obsolete code: Handle suspend/resume events}
  250. {if e.what = OSevt then}
  251. {begin}
  252. {if BAND(BROTL(e.message, 8), $FF) = SuspendResumeMessage then}
  253. {DoSuspendResume(BAnd(e.message, 1) <> 0);}
  254. {DoEvt := true;}
  255. {end}
  256. {else}
  257.  
  258.         DoEvt := false; {We never actually PROCESS any event here!}
  259.         if e.what = kHighLevelEvent then
  260.             if not gAppleEventsInitialized then {My little "cheat" into compatibility}
  261.                 AppleEventInit;
  262. {if AEProcessAppleEvent(e) <> noErr then}
  263.     end; { DoEvt }
  264.  
  265.  
  266.     procedure EmergencyExit;
  267.     begin
  268. {Fade back in on emergency exits, so we don't leave the screen faded!}
  269.         FadeScreen(1, false, fadeTo);
  270.     end; {EmergencyExit}
  271.  
  272.     var
  273.         loadWind: WindowPtr;
  274.  
  275.     procedure ShowLoadWind;
  276.         var
  277.             s: Str255;
  278.             fontNum: Integer;
  279.             world: SysEnvRec;
  280.             tempColorFlag: Boolean;
  281.             height, width: Integer;
  282.     begin
  283.         tempColorFlag := false;
  284.         if noErr = SysEnvirons(1, world) then
  285.             if world.hasColorQd then
  286.                 tempColorFlag := true;
  287. {$IFC UNDEFINED THINK_PASCAL}
  288.         if tempColorFlag then
  289.             loadWind := NewCWindow(nil, qd.screenBits.bounds, '', true, plainDBox, WindowPtr(-1), false, 0)
  290.         else
  291.             loadWind := NewWindow(nil, qd.screenBits.bounds, '', true, plainDBox, WindowPtr(-1), false, 0);
  292. {$ELSEC}
  293.         if tempColorFlag then
  294.             loadWind := NewCWindow(nil, screenBits.bounds, '', true, plainDBox, WindowPtr(-1), false, 0)
  295.         else
  296.             loadWind := NewWindow(nil, screenBits.bounds, '', true, plainDBox, WindowPtr(-1), false, 0);
  297. {$ENDC}
  298.  
  299. {Up with the loading window and draw SOMETHING}
  300.         SetPort(loadWind);
  301. {Paint the window pink}
  302.         if tempColorFlag then
  303.             RGBForeColor(fadeTo);
  304.         PaintRect(loadWind^.portRect);
  305. {Select 24-point Geneva}
  306.         TextSize(24);
  307.         TextFace([bold]);
  308.         GetFNum('Geneva', fontNum);
  309.         TextFont(fontNum);
  310. {Get the loading string and draw it}
  311.         s := MyGetIndString(loadingStrID);
  312.         height := loadWind^.portRect.bottom - loadWind^.portRect.top;
  313.         width := loadWind^.portRect.right - loadWind^.portRect.left;
  314.         MoveTo(width div 2 - StringWidth(s) div 2, height div 2);
  315.         ForeColor(redColor);
  316.         DrawString(s);
  317.         ForeColor(blackColor);
  318.     end; {ShowLoadWind}
  319.  
  320. { -------------------------------------------------------------------- }
  321. {                                    Main                                }
  322. { -------------------------------------------------------------------- }
  323.  
  324.     var
  325.         r: Rect;
  326.  
  327. begin
  328.     SkelInit(6, nil);                { initialize }
  329.     SetUpMenus;                { install menu handlers }
  330.  
  331.     SetCursor(GetCursor(watchCursor)^^);
  332.  
  333. {Is the user holding down a modifier key? If so, we should use the whole screen.}
  334.     GetKeys(keys);
  335.     zoomFlag := keys[55] or keys[56] or keys[58] or keys[59]; {cmd, shift, alt, ctrl}
  336.  
  337. {Tell SAT that we want it to rescale the PICTs}
  338.     SATConfigure(true, kVPositionSort, kKindCollision, 32);
  339.  
  340. {Send strings from resources to SAT, so the program can be localized.}
  341.     SATSetStrings(MyGetIndString(okStrID), MyGetIndString(yesStrID), MyGetIndString(noStrID), MyGetIndString(quitStrID), MyGetIndString(memerrStrID), MyGetIndString(noscreenStrID), MyGetIndString(satnopictStrID), MyGetIndString(nowindStrID));
  342.  
  343. {Before fading, set the emergency exit routine to one where we restore the screen!}
  344.     SATInstallEmergency(@EmergencyExit);
  345.  
  346.     fadeTo.red := -1;
  347.     fadeTo.green := $a000;
  348.     fadeTo.blue := $a000;
  349.     FadeScreen(30, true, fadeTo);
  350.     ShowLoadWind;
  351.     FadeScreen(30, false, fadeTo);
  352.  
  353. { Initialize the Sprite Animation Toolkit, set up offscreen buffers and make the window. }
  354.  
  355.     if zoomFlag then {if cmd, shift, alt, ctrl}
  356.         SetRect(r, 0, 0, 32000, 32000) {Very big - makes SAT cut it down to the main screen.}
  357.     else
  358.         SetRect(r, 0, 0, 512, 342); {Standard size}
  359.     SATCustomInit(132, 133, r, nil, nil, true, true, true, true, true);
  360.  
  361. {Here we can call SATSoundInitChannels if we want more than one channel.}
  362.     if SATSoundInitChannels(2) < 2 then
  363.         ;
  364.     SATPreloadChannels;
  365.  
  366. { Init all the different parts of the game. }
  367.     GameWindInit;    { Init the game window }
  368.  
  369. { Initialize the sprites }
  370.     InitSprites;
  371. {We draw some of the background -the trees - ourselves in this game.}
  372.     DrawBackground;
  373.  
  374.     FadeScreen(30, true, fadeTo);
  375. { Draw the contents of the window (to give the user something to look at during the rest of startup). }
  376.     DisposeWindow(loadWind);
  377.     ShowWindow(gSAT.wind.port);
  378.     SelectWindow(gSAT.wind.port);
  379.     HQRedraw;
  380.     FadeScreen(30, false, fadeTo);
  381.  
  382.     Loadsounds;        { preload all sound resources }
  383.     InitScores;        { Init the score module, check if a pref file should be created }
  384.     InitSettings;    { Load the settings }
  385.  
  386. { Set the randseed to something that is random enough. }
  387. {$IFC UNDEFINED THINK_PASCAL}
  388.     qd.randSeed := TickCount;
  389. {$ELSEC}
  390.     randSeed := TickCount;
  391. {$ENDC}
  392.  
  393.     SkelEventHook(@DoEvt); { handle MultiFinder-events }
  394.     SkelSetSuspendResume(@DoSuspendResume); {NEW call in my version of TransSkel 2.0}
  395.     InitCursor;
  396.  
  397.     SkelMain;                { loop 'til Quit selected }
  398.     SkelClobber;                { clean up }
  399.     SATSoundShutUp;            { Terminate sounds }
  400. end.